COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE Auxiliary routines to do I/O & system calls from Pascal
C00004 00003	Misc routines: BEEP,INITSC,REINIT,RESETS,CLEARS & ECHO, ESCINI & INTRTN
C00009 00004	Time related routines: getTime, markTime & clrTime
C00010 00005	Cursor postioning routine: SHOWCU
C00014 00006	Aux routines to set up position commands: DMPOS & DDPOS
C00016 00007	Line output routine: OUTLIN
C00022 00008	Character routines: GETCHAR, ANYCHAR & OUTCHAR
C00024 00009	Special DM routines: INSCHA, DELCHA, INSLIN & DELLIN
C00027 00010	Line editor routines: LINEDP & LOADED
C00030 00011	Message passing routines: BITON, INITME, GETMES, SENDME, PUPINT
C00044 00012	Routines to connect/disconnect Al & arm servo via ethernet: CONNEC & DISCON
C00048 00013	Ethernet routine to talk through speech synthesizer on 11/45
C00051 ENDMK
C⊗;
TITLE Auxiliary routines to do I/O & system calls from Pascal

P ← 17
DMFLAG ←  32000
DDFLAG ←  200000
DMQUOT ←  100000
USERGO ←  2000

DD ← 20000	;RUNNING ON DATA DISK (BITS FROM GETLIN)
DM ← 40000	;  "     "  DATAMEDIA

DEFINE CW(C1,D1,C2,D2,C3,D3)<BYTE(8)D1,D2,D3(3)C1,C2,C3,4>

	TWOSEG 400000		;Initialize for two-segments
	RELOC 0
	RELOC 400000

INTERNAL BEEP,INITSC,REINIT,RESETS,CLEARS,ECHO,SHOWCU,OUTLIN,LINEDP,LOADED
INTERNAL GETCHA,ANYCHA,OUTCHA,INSCHA,DELCHA,INSLIN,DELLIN,ESCINI
INTERNAL GETTIM,MARKTI,CLRTIM
INTERNAL INITME,GETMES,SENDME,BITON,CONNEC,DISCON,TALK11

EXTERNAL NEW

;Misc routines: BEEP,INITSC,REINIT,RESETS,CLEARS & ECHO, ESCINI & INTRTN

BEEP:	HRROI 1,-1
	BEEP 1,
	POPJ P,

INITSC:	MOVEM 2,TBASE		;Remember base address of listing array
	SETO 1,
	GETLIN 1		;get our terminals characteristics
	SETZ 2,			;Assume DM
	TLNE 1,DD		;Check if Data Disk
	JRST IDD		; yup - deal with it below
	MOVE 1,[XWD DMFLAG,LPOS]
	MOVEM 1,LBCMD		;Set things up for OUTLIN
	MOVEI 4,=22		;DM's have 24 lines, but leave 2 for the wholine
	JRST I1
IDD:	AOJ 2,			; Is DD
	MOVE 1,[XWD DDFLAG,LBCMD1]
	MOVEM 1,LBCMD		;Set things up for OUTLIN
	MOVEI 4,=38		;DD's have 40 lines, but leave 2 for the wholine
I1:	MOVEM 2,TERM		;Store away for later
	MOVEM 4,1(P)		;Return screen height
	POPJ P,

	RELOC		;use low seg
TBASE:	0
TERM:	0		;0 = DM, 1 = DD
	RELOC		;back to high seg

REINIT:	PUSHJ P,CLEARS		;Clear the screen
	DPYSIZ 3002		; = 3 glitches/ 2 lines each (not really used)
	DPYPOS -1777		;Move page printer off page
	SETACT [0,,ACTTAB]	;Activate on ANY character (bye-bye line editor)
	MOVE 1,[-1,,ACTON]	;Turn on special activation mode
	TTYSET 1,
	POPJ P,

RESETS:	SETACT [0,,ACTOLD]	;Restore world for line editor
	MOVE 1,[-2,,ACTOFF]	;Turn off special activation mode & do a break N
	TTYSET 1,
	POPJ P,

ACTOFF:	XWD 002000,100		;Turn off special activation mode
	XWD 004000,516		;Clear & Normalize screen via Break N
ACTON:	XWD 001000,100		;Turn on special activation mode
ACTTAB:	XWD 777777,777777	;Special activation table
	XWD 777777,777777	; activate on ALL characters
	XWD 777777,777777
	XWD 777777,640066	;also set SUPCT,ALLACT,BSACT,SUPSCM & SUPCCR
ACTOLD:	OCT 0,0,0,0		;so we can turn off the above bits

CLEARS:	MOVE 7,TERM
	DPYOUT @CLR(7)	;Clear the screen
	POPJ P,

CLR:	DMCLRH
	DDCLRH

DDCLRH:	DDCLR
	2
	0
	0

DDCLR:	CW 1,17,2,0,1,46
	0					;Halt

DMCLRH:	XWD DMFLAG,DMCLR
	1
	0
	0

DMCLR:	77474		;clear

ECHO:	MOVEI 1,4	;Assume we want echoing on (DON = 4)
	SKIPN 2		;See what we're to do
	SOJ 1,		;If ac2 = 0 (false) turn echoing off (DOFF = 3)
	SETZM 0		;Use our terminal
	PTJOBX 0	;Do it
	POPJ P,

JOBINT ← 71

ESCINI:	MOVEM 2,ESCFLG	;Get address of escape-I flag word;
	MOVEM 3,TIMFLG	;Get address of timer flag word;
	HRRZI 1,INTVEC	;Use INTVEC instead of JOBCNI, JOBTPC & JOBAPR
	MOVEM 1,JOBINT	;So Pascal can use old style interrupts
	HRLZI 1,4	;Escape-I interrupt bit
	INTENB 1,	;Enable interrupts for it
	POPJ P,

INTRTN:	MOVE 1,INTVEC	;Get the bit indicating the cause of the interrupt
	TLNE 1,10	;Skip if interrupt not due to receipt of PUP packet
	JRST PUPINT	;Go read in the packet & deal with it
	TLNN 1,200	;Skip if a clock interrupt
	JRST ESCINT	;Else it must be an escape-I interrupt

TIMINT:	SETOM @TIMFLG	;Indicate scheduling interval has elapsed
	CLKINT 0	;Turn off clock timer
	DISMIS		;All done

ESCINT:	SETOM @ESCFLG	;Set flag when we get an escape-I interrupt
	DISMIS		;That's all we need to do

	RELOC		;Use low seg

INTVEC:	0		;JOBCNI
	0		;JOBTPC
	INTRTN		;JOBAPR

ESCFLG:	0
TIMFLG:	0

	RELOC		;back to high seg

;Time related routines: getTime, markTime & clrTime

GETTIM:	TIMER 1,	;Get current time in 60ths of a second after midnight
	MOVEM 1,1(P)	;Return time
	POPJ P,

MARKTI:	CLKINT (2)	;Schedule a clock interrupt in WHEN ticks
	TIMER 1,	;Get current time in 60ths of a second after midnight
	ADD 1,2		;Add in time to wait
	MOVEM 1,1(P)	;Return time clock set to interrupt
	POPJ P,

CLRTIM:	CLKINT 0	;Disable clock interrupts
	POPJ P,

;Cursor postioning routine: SHOWCU

SHOWCU:	CAIG 3,=80	;check for line overflow
	JRST .+3	; no
	SUBI 3,=80	; yes - correct column number
	AOJ 2,		;  & bump line number
	SOJ 3,		;columns go from 0 not 1
	ADDI 2,2	;line 0 is really at line 2, so wholine isn't clobbered
	SKIPE TERM	;What sort of terminal are we using
	JRST SHDDCU	; Handle DD's below
SHDMCU:	HRRM 2,CURADR	;line	DM
	HRLM 3,CURADR	;column
	CURSOR CURADR
	POPJ P,

	RELOC		;low seg
CURADR:	0
	RELOC		;back to high seg

				;Most of this is stolen from E/363P
SHDDCU:	MOVE 5,[CW 3,0,4,0,5,0]	;Column number and line address (high & low parts)
	IMULI 2,=12		;Convert to scan line number
	ADDI 2,=10		;Put our cursor near bottom of text line
	DPB 2,[POINT 4,5,23]	;Put in low order line address
	LSH 2,-4
	DPB 2,[POINT 5,5,15]	;And high order line address
	MOVE 2,3		;Column number
	IMULI 2,6		;Column times char width in bits gives bit position
	LDB 3,[POINT 3,2,35]	;Get bit offset within graphic column
	LSH 2,-3		;Get graphic column number in low-order bits
	ADDI 2,1		;First graphics column under normal text is 1
	DPB 2,[POINT 6,5,7]	;Insert column in cmd word
	MOVEM 5,NEWCUR		;Store away new cursor position
	MOVN 3,3
	MOVSI 1,770000		;Bits for cursor
	LSH 1,-1(3)		;Adjust bits into right position within column
	TRZ 1,17		;Make sure no stray bits on
	IORI 1,2		;Make this a graphics word
	MOVEM 1,CURBTS
	DPYOUT CURHD		;Do it
	MOVEM 5,OLDCUR		;So we can erase it next time
	POPJ P,

CURHD:	CURCMD
	10
	0
	0

	RELOC		;low seg
CURCMD: CW 1,7,1,7,1,7		;Graphics mode to diddle cursors
OLDCUR:	CW 3,1,4,0,5,10		;Position cmd for old cursor
	2			;Graphic bits to erase old cursor
	CW 0,0,3,1,3,1		;Now an execute to erase the bits
NEWCUR:	CW 3,1,4,0,5,10		;Position cmd for new cursor
CURBTS:	2			;Graphic bits to draw new cursor
	CW 0,0,3,1,3,1		;Now an execute to write the bits
	0			;and finally a halt
	RELOC		;back to high seg

;Aux routines to set up position commands: DMPOS & DDPOS

DMPOS:	HRRZI 1,37614		; '177 & '14 = set cursor position
	LSH 1,7
	CAIG 3,=80		;check for line overflow
	JRST .+3		; no
	SUBI 3,=80		; yes - correct column number
	AOJ 2,			;  & bump line number
	SOJ 3,			;DM columns go from 0 not 1
	IOR 1,3			;Grab column value
	XORI 1,140
	LSH 1,7
	ADDI 2,2		;line 0 -> line 2, so wholine isn't clobbered
	IOR 1,2			;Grab line number
	XORI 1,140
	LSH 1,1
	POPJ P,

DDPOS:	CAIG 3,=80		;check for line overflow
	JRST .+3		; no
	SUBI 3,=80		; yes - correct column number
	AOJ 2,			;  & bump line number
	ADDI 2,2		;line 0 -> line 2, so wholine isn't clobbered
	IMULI 2,14		;Compute DD line number from screen text line number
	DPB 2,[400400,,2]	; (this code is snarfed from e/171p)
	TRZ 2,17
	ROT 2,20
	TDO 2,[CW 3,0,4,0,5,0]
	AOJ 3,			;DD columns start at 2
	LSH 3,=28		;Shift it to proper byte
	IOR 2,3			;Or it into command word
	MOVEM 2,LPOS		;Set up line address command
	POPJ P,

;Line output routine: OUTLIN

OUTLIN:	CAIG 5,0		;Make sure # chars to print > 0
	POPJ P,			; else nothing to do
	MOVE 6,5		;Compute col + length ( + 1)
	ADD 6,3
	CAILE 6,=81		;Make sure line won't be too long
	PUSHJ P,OUTLNG		; handle long lines below
	SKIPE TERM		;What sort of terminal are we using
	JRST ODDLIN		; Handle DD's below
ODMLIN:	PUSHJ P,DMPOS		;Set up DM cursor address
	MOVEM 1,LPOS		;Set up line address
	MOVE 6,4		;Get offset of first char to write
;	SOJ 6,			;Convert bytes to word offset
	IDIVI 6,5		; (ac7 = byte offset in first word)
	MOVE 10,TBASE		;Array base address
	ADD 10,6		;base + offset
	MOVSS 10		;Put it in left half of AC
	HRRI 10,LBUF		;DM buffer goes in right half
	MOVE 1,5		;Get # of chars to write
	ADD 1,7			;Plus any leading chars in first word
	IDIVI 1,5		;Convert to words (ac2 = # extra bytes)
	CAIE 2,0		;If any extra bytes
	AOJ 1,			; need to bump # of words to transfer	
	BLT 10,LBUF-1(1)	;Transfer line into buffer
	MOVE 10,BMASK(7)	;Get bit mask
	ANDM 10,LBUF		;Zero out extraneous leading chars
	MOVE 10,BMASK(2)	;Now handle trailing chars
	CAIE 2,0		; (if any)
	ANDCAM 10,LBUF-1(1)	;Zero out extraneous trailing chars
	HRLZI 10,774560		; 177 & 27 = erase til end of line
	MOVEM 10,LBUF(1)
	ADDI 1,2		;Number of words to send DM
	MOVEM 1,LBSIZ
	DPYOUT LBCMD		;Do it!
	POPJ P,

ODDLIN:	PUSHJ P,DDPOS		;Set up DD position command
	MOVE 6,4		;Get offset of first char to write
;	SOJ 6,			;Convert bytes to word offset
	IDIVI 6,5		; (ac7 = byte offset in first word)
	MOVE 10,TBASE		;Array base address
	ADD 10,6		;base + offset
	HRRZI 11,LBUF		;DD buffer goes in LBUF
	MOVE 1,5		;Get # of chars to write
	ADD 1,7			;Plus any leading chars in first word
	IDIVI 1,5		;Convert to words (ac2 = # extra bytes)
	CAIE 2,0		;If any extra bytes
	AOJ 1,			; need to bump # of words to transfer	
	MOVN 5,1
	HRL 10,5		;ac7 = -N,,TBASE+offset
LPLP:	MOVE 3,(10)		;Get next word to transfer
	TRO 3,1			;Make it a text word
	MOVEM 3,(11)		;Transfer it into the buffer
	AOJ 11,
	AOBJN 10,LPLP		;Get all of them
	MOVE 10,BMASK(7)	;Get bit mask
	TRO 10,1
	ANDM 10,LBUF		;Zero out extraneous leading chars
	MOVE 10,BMASK(2)	;Now handle trailing chars
	CAIE 2,0		; (if any)
	ANDCAM 10,LBUF-1(1)	;Zero out extraneous trailing chars
	MOVE 0,[CW 0,0,4,0,4,0]
	MOVEM 0,LBUF(1)		;Append an execute command
	SETZM LBUF+1(1)		;Append a halt command
	ADDI 1,4		;Number of words to send DD
	MOVEM 1,LBSIZ
	DPYOUT LBCMD		;Do it!
	POPJ P,

BMASK:	BYTE (7) 177,177,177,177,177	;Masks to zero leading chars
	BYTE (7) 0,177,177,177,177	;Use complement for killing trailing chars
	BYTE (7) 0,0,177,177,177
	BYTE (7) 0,0,0,177,177
	BYTE (7) 0,0,0,0,177

	RELOC		;use low seg
LBCMD:	XWD DDFLAG,LBCMD1
LBSIZ:	10		;# of words to write out
	0
	LPOS		;address of low order line command

LBCMD1:	CW 1,46,1,46,1,46
LPOS:	0		;Cursor command for start of line
LBUF:	BLOCK =20
	RELOC		;back to high seg

OUTLNG:	CAILE 3,=80	;Don't bother if col > 80
	POPJ P,		; just return
	PUSH P,2	;Save line number
	SUBI 6,=81	;# of chars for overflow line
	PUSH P,6	;Save it
	SUB 5,6		;# of chars for first line
	MOVE 6,4	;Offset of 1st char for 1st line
	ADD 6,5		;Offset of 1st char for 2nd line
	PUSH P,6	; save it
	PUSHJ P,OUTLIN	;Write out 1st line
	POP P,4		;Offset of 1st char
	POP P,5		;# of chars
	POP P,2		;Line number
	AOJ 2,		; bump it
	MOVEI 3,1	;Start 2nd line in 1st column
	POPJ P,		;Finally return for last part of line

;Character routines: GETCHAR, ANYCHAR & OUTCHAR

GETCHA:	INCHRW 1		;Read in the next character
	TRZ 1,400		;We never want to see meta!
	MOVEM 1,1(P)		;Return char
	POPJ P,

ANYCHA:	SETOM 1			;Assume there's a character to read in
	INCHRS (2)		;Read in the next character (if any)
	SETZM 1			;FALSE if nothing to read yet
	MOVEM 1,1(P)		;Report success or failure
	POPJ P,

OUTCHA:	LSH 4,=29		;Left justify char to output
	SKIPE TERM		;What sort of terminal are we using
	JRST OUTCDD		; Handle DD's below
OUTCDM:	PUSHJ P,DMPOS		;Set up DM position command
	MOVEM 1,LPOS		;Set up line address
	JUMPE 5,ODM1		;Skip ahead if not bold
	HRRI 4,37616		; 177 & 16 = bold on
	ROT 4,-=14		;Put bold cmd in high bits
ODM1:	MOVEM 4,LBUF		;Stick char to write in buffer
	MOVEI 1,2		;Number of words to send DM
	MOVEM 1,LBSIZ
	DPYOUT LBCMD		;Do it!
	POPJ P,

OUTCDD:	PUSHJ P,DDPOS		;Set up DD position command
	TRO 4,1			;Make it a text word
	MOVEM 4,LBUF		;Transfer it into the buffer
	MOVE 1,[CW 0,0,4,0,4,0]
	MOVEM 1,LBUF+1		;Append an execute command
	SETZM LBUF+2		;Append a halt command
	MOVEI 1,5		;Number of words to send DD
	MOVEM 1,LBSIZ
	DPYOUT LBCMD		;Do it!
	POPJ P,

;Special DM routines: INSCHA, DELCHA, INSLIN & DELLIN

INSCHA:	PUSHJ P,DMPOS		;Set up DM position command
	LSH 1,7			;Flush 177 byte
	MOVEM 1,IDPOS		;Set up line address
	MOVE 1,[BYTE (7) 20,34,30,16,0]	;Enter i/d mode, add space, can, bold
	MOVEM 1,IDPOS+1		;Set up I/D command
	LSH 4,=29		;Left shift char to output
	MOVEM 4,IDPOS+2		;Stick it into buffer
	MOVEI 1,3
	MOVEM 1,IDCMD+1		;Three words to write out
	DPYOUT IDCMD		;Do it!
	POPJ P,

DELCHA:	PUSHJ P,DMPOS		;Set up DM position command
	LSH 1,7			;Flush 177 byte
	MOVEM 1,IDPOS		;Set up line address
	MOVE 1,[BYTE (7) 20,10,30,16,0]	;Enter i/d mode, delete char, can, bold
	MOVEM 1,IDPOS+1		;Set up I/D command
	MOVEI 1,2
	MOVEM 1,IDCMD+1		;Two words to write out
	DPYOUT IDCMD		;Do it!
	POPJ P,

INSLIN:	MOVEI 4,12		;12 = Add row in i/d mode
	CAIA			;Skip ahead to common code
DELLIN:	MOVEI 4,32		;32 = Delete row in i/d mode
	SKIPN 5,3		;Save # of lines to insert/delete
	POPJ P,			; (if none all done)
	MOVEI 3,1
	PUSHJ P,DMPOS		;Set up positioning command;
	LSH 1,7			;Flush 177 byte
	IORI 1,40		;Or enter i/d mode (= 20) into command
	MOVEM 1,IDPOS		;Set up line address & enter i/d mode
	MOVE 1,[POINT 7,IDPOS+1] ;Byte pointer for where to put i/d chars
IDLP:	IDPB 4,1		;Move it into buffer
	SOJG 5,IDLP		;# of lines to do
	MOVEI 4,30		;Exit i/d mode
	IDPB 4,1
	IDPB 5,1		;Tack on some nulls to fill word
	IDPB 5,1
	IDPB 5,1
	IDPB 5,1
	IBP 1
	HRRZ 2,1		;Ac2 = end of command buffer
	SUBI 2,IDPOS		;Get # of chars to write out
	MOVEM 2,IDCMD+1
	DPYOUT IDCMD		;Do it!
	POPJ P,

	RELOC		;use low seg
IDCMD:	XWD DMQUOT+DDFLAG+USERGO,IDPOS
	3		;# of words to write out
	0
	0

IDPOS:	0		;Cursor command for start of line
	BYTE (7) 20,34,30,16,0	;Enter i/d mode, add space, can, bold
	0		;Char to output
	0
	0
	0
	RELOC		;back to high seg

;Line editor routines: LINEDP & LOADED

LINEDP:	ADDI 2,2	;line 0 is really at line 2, so wholine isn't clobbered
	AOJ 2,			;we use the same algorithm as E (/171p)
	LSH 2,7			;multiply by 200
	MOVE 3,[-3]		;For DM's
	SKIPE TERM		;Different spacing for different terminal types
	MOVE 3,[-5]		;For DD's
	IDIV 2,3
	ADDI 2,1000		;top of screen = 1000
	LEYPOS (2)		;Do it
	POPJ P,

LOADED:	MOVEI 1,0		;Load line editor & move cursor to char #N
	SOJLE 5,LOED0		; (actually <cntl><n-1><cntl><space>)
	IDIVI 5,=10
	MOVE 1,[BYTE (9) 260,260,240,0]	;<cntl>0 <cntl>0 <cntl><sp> null
	LSH 5,=27
	ADD 1,5			;Deal with 10's
	LSH 6,=18
	ADD 1,6			;Deal with 1's
LOED0:	MOVEM 1,LOED3		;Number of spaces into line to move cursor
	MOVE 10,[POINT 7,LBUF]	;Byte pointer for where to put line
	JUMPE 4,LOED1		;Skip ahead if no chars to load
	MOVE 6,3		;Get offset of first char to load in
;	SOJ 6,			;Convert bytes to word offset
	IDIVI 6,5		; (ac7 = byte offset in first word)
	ADD 6,TBASE		;base + offset
	IMUL 7,[-7]
	ADDI 7,=36		;Make up P field
	LSH 7,=30
	XOR 7,[POINT 7,(6),35]	;Need to make up byte pointer
LOEDLP:	ILDB 1,7		;Get next char
	IDPB 1,10		;Move it into buffer
	SOJG 4,LOEDLP		;Get them all
LOED1:	HRRZI 1,15		;Tack on a CR
	IDPB 1,10		;Move it into buffer
	PUSHJ P,LINEDP		;Move line editor to right line
	PTL7W9 LOED2		; & load it
	POPJ P,

LOED2:	0			;Use own terminal
	LBUF			;address of string to load
	LOED3			;9 bit string of simulated type ahead

	RELOC			;Back to low seg
LOED3:	BYTE (9) 260,260,240,0	;<cntl>0 <cntl>0 <cntl><sp>
	RELOC			;To high seg

;Message passing routines: BITON, INITME, GETMES, SENDME, PUPINT

ARMCHN ← 14		;Channel used for AL-ARM interaction

HELLOP ← 200		;Pup types for AL-ARM communication
ARMFRE ← 201
ARMBSY ← 202
THEREP ← 203
ALLIVE ← 204
ALARM  ← 205
ACK    ← 206
BYEBYE ← 207

OK ← 0			;Offsets for fields in message records
CMD ← 1
DEV ← 2
BITS ← 3
N ← 4
ERROR ← 5
EVT ← 6
DUR ← 7
V1 ← 10
V2 ← 11
V3 ← 12
T1 ← 13
T2 ← 14
T3 ← 15
T4 ← 16
T5 ← 17
T6 ← 20
T7 ← 21
T8 ← 22
T9 ← 23
T10 ← 24
T11 ← 25
T12 ← 26

IMAX16 ← 77777			;Maximum 16-bit integer
IMIN16 ← -100000		;Minimum 16-bit integer

BITON:	AND 2,ALMSG+BITS	;Is the bit on in BITS field of message?
	CAIE 2,0		;Skip if False
	SETO 2,			;Else set to TRUE
	MOVEM 2,1(P)		;Return truth value
	POPJ P,

INITME:	MOVEI 1,ALMSG		;Pass AL the pointer to standard message record
	MOVEM 1,(2)
	MOVEM 3,MSGFLG		;Flag to set upon receipt of message from ARM
	POPJ P,

GETMES:	MOVE 2,MSGQUE		;Get pointer to next message for AL
	CAIN 2,0		;Skip if there is one
	JRST NOMES		;Else punt
	HRLZI 1,1(2)		;Transfer message (not next field though)
	HRRI 1,ALMSG
	BLT 1,ALMSG+T12		;Copy it
	IMSKCL PUPMSK		;Entering critical region
	MOVE 1,(2)		;Get pointer to next message
	MOVE 0,FREEMS		;Add old message to start of free list
	MOVEM 0,(2)		;Pointer to rest of free message blocks
	MOVEM 2,FREEMS
	HRRZI 2,MSGQUE
	MOVEM 1,MSGQUE		;Update list
	CAIN 1,0		;List now empty?
	MOVEM 2,LSTMSG		; Yes
	IMSKST PUPMSK		;End of critical region
	SETO 2,			;Indicate there was a message
NOMES:	MOVEM 2,1(P)		;Return truth value
	POPJ P,

PUPMSK:	XWD 10,0		;To set/clear ethernet interrupt mask bit

	RELOC			;Back to low seg

MSGQUE:	0			;Message queue awaiting AL
LSTMSG:	MSGQUE

FREEMS:	M1			;Initially have seven free messages

MSGFLG:	0

ALMSG:	BLOCK =25		;Message record used by AL

M1:	M2
	BLOCK =25

M2:	M3
	BLOCK =25

M3:	M4
	BLOCK =25

M4:	M5
	BLOCK =25

M5:	M6
	BLOCK =25

M6:	0			;Last initally allocated message
	BLOCK =25

ACKPUP:	BLOCK =6

OUTPUP:	BLOCK =140

PUPOUT:	IOWD 140,OUTPUP		;Dump mode command list to output pup packet
	0

INPUP:	BLOCK =140

OUTSEQ:	0			;Sequence number for pups from SAIL to 11
INSEQ:	0			;Sequence number for pups to SAIL from 11
ACKFLG:	0			;Flag set when an ACK is received
PUPTRY:	0			;Number of times tried to send pup without ACK

	RELOC			;To high seg

PUPACK:	IOWD =6,ACKPUP		;Dump mode command list to output pup packet
	0

PUPIN:	IOWD 140,INPUP		;Dump mode command list to input pup packet
	0

ACKLEN:	POINT 16,ACKPUP,15	;PUP length
ACKTYP:	POINT 16,ACKPUP,31	;PUP type (+ transport control)
ACKID:	POINT 32,ACKPUP+1,31	;PUP identifier

PUPLEN:	POINT 16,OUTPUP,15	;PUP length
PUPTYP:	POINT 16,OUTPUP,31	;PUP type (+ transport control)
PUPID:	POINT 32,OUTPUP+1,31	;PUP identifier
PUPDAT:	POINT 8,OUTPUP+5	;First 8-bit data byte

INPTYP:	POINT 8,INPUP,31	;PUP type
INPID:	POINT 32,INPUP+1,31	;PUP identifier

OKF:	POINT 8,5(2),7		;AL-ARM message fields in PUP
CMDF:	POINT 8,5(2),15
DEVF:	POINT 16,5(2),31
BITSF:	POINT 16,6(2),15
NF:	POINT 16,6(2),31
EVTF:	POINT 32,7(2),31
ERRORF:	POINT 8,INPUP+11,15	;Error field only written by ARM for AL

SENDME:	MOVEI 2,OUTPUP		;Code to copy AL's message into OUTPUP
	MOVE 0,ALMSG+OK		;Converting to data format used by 11
	DPB 0,OKF
	MOVE 0,ALMSG+CMD
	DPB 0,CMDF
	MOVE 0,ALMSG+DEV	;Always positive
	DPB 0,DEVF
	MOVE 0,ALMSG+BITS	;Always positive
	DPB 0,BITSF
	MOVE 0,ALMSG+N
	CAILE 0,IMAX16		;Make sure IMIN16 <= N <= IMAX16
	MOVEI 0,IMAX16
	CAMGE 0,[IMIN16]
	MOVE 0,[IMIN16]
	DPB 0,NF
	MOVE 0,ALMSG+EVT
	DPB 0,EVTF
	MOVE 1,[XWD -=16,0]
SEND0:	SETZ 3,
	MOVE 4,ALMSG+DUR(1)	;Get next floating point number
	JUMPGE 4,SEND1		;Skip ahead if positive floating point number
	MOVNS 4			;If negative, make it positive
	HRLZI 3,400000		; & set sign bit for 11
SEND1:	IOR 3,4			;OR in exponent
	AND 3,EXPMSK		;Flush fraction
	AND 4,[000377777770]	;Flush exponent & sign & highest order bit
	LSH 4,1			;Shift it over since we flushed MSB
	IOR 4,3			;Retrieve sign bit & exponent
	MOVEM 4,OUTPUP+10(1)	;Store it in OUTPUP
	AOBJN 1,SEND0		;Do all of the floating point fields

	AOS OUTSEQ		;Update sequence number
	MOVE 1,[037777777777]	;Make sure it stays less than 32 bits long
	ANDM 1,OUTSEQ
	SETZM ACKFLG		;Clear pup sent ok flag
	MOVEI 1,=10
	MOVEM 1,PUPTRY		;Try at most 10 times

SENDLP:	IMSKST PUPMSK		;Make sure we can receive pup interrupts
	HRLZI 1,10		;INTINP bit
	INTORM 1,		;Enable interrupts for receiving PUP packets
	MOVE 1,OUTSEQ		;Get sequence number for this packet
	DPB 1,PUPID
	HRRZI 1,ALARM		;Set PUP type to AL-ARM message packet
	DPB 1,PUPTYP
	MOVEI 1,=96		;Length of AL-ARM message (data + overhead)
	DPB 1,PUPLEN
	MOVNI 1,=24		;Length in words on the 10
	HRLM 1,PUPOUT		;Set size for dump mode command list
	OUTPUT ARMCHN,PUPOUT	;Send packet away to ARM server
	MOVEI 3,=12		;Give ARM 1/5 second to respond (= 12 ticks)
SNDLP1:	SETZ 1,			;Now sleep one tick
	SLEEP 1,
	SKIPE 2,ACKFLG		;Did we get an ACK? (will be all ones or zeros)
	JRST SENDOK		; Yes - all done
	SOJG 3,SNDLP1		; No - loop if still waiting
	SOSE PUPTRY		; No - have we tried to send at least 10 times?
	JRST SENDLP		;  No - send pup out again
				;  Yes - return failure
SENDOK:	MOVE 1,[XWD -=25,ALMSG]	;Now zero AL message packet
SNDOK1:	SETZM (1)
	AOBJN 1,SNDOK1
	MOVEM 2,1(P)		;Return truth value
	POPJ P,

EXPMSK:	777000000000		;Mask for exponent & sign bit

PUPINT:	INPUT ARMCHN,PUPIN	;Read in the PUP packet
	LDB 1,INPTYP		;Get PUP type
	LDB 2,INPID		; & it's ID sequence number
	CAIE 1,ACK		;Is it an ACK from ARM?
	JRST PINT0		; No
	CAME 2,OUTSEQ		; Yes - is it for last PUP we sent to ARM?
	JRST PINTX		;   No - just ignore it.  All done.
	SETOM ACKFLG		;   Yes - make a note of it.
;	UWAIT			;	& wake up AL early
	JRST PINTX		;	All done.
PINT0:	CAIE 1,THEREP		;Is ARM wondering if we're still here?
	JRST PINT1		; No
	HRRZI 1,ALLIVE		; Yes - tell it we're still alive & well
	DPB 1,ACKTYP
	HRRZI 1,=22		;Size of ALLIVE pup = pup overhead
	DPB 1,ACKLEN
	OUTPUT ARMCHN,PUPACK	;Send packet away
PINT1:	CAIE 1,ALARM		;An AL-ARM message packet?
	JRST PINTX		; No - just ignore it
	HRRZI 1,ACK		; Yes - send an ACK back to ARM
	DPB 1,ACKTYP
	DPB 2,ACKID		;Use correct sequence number
	HRRZI 1,=22		;Size of ACK pup = pup overhead
	DPB 1,ACKLEN
	OUTPUT ARMCHN,PUPACK	;Send packet away
	CAMG 2,INSEQ		;Have we already seen this PUP packet?
	JRST PINTX		; Yes - ignore this copy of it
	MOVEM 2,INSEQ		; No - update sequence number & deal with it
	SKIPE 1,FREEMS		;Get a free message block
	JRST PINT2		;Got one from free list
	HRRZI 2,=26		;Message blocks are 26. words long
	PUSHJ P,NEW		;Get one from free storage via NEW
	MOVEI 1,(2)		;Copy pointer
	SETZM (1)		;Zero it's next pointer
PINT2:	MOVE 0,(1)		;Pointer to next message in free list
	MOVEM 0,FREEMS		;Make it head of list
	MOVE 2,LSTMSG		;Get pointer to last message pending for AL
	MOVEM 1,(2)		;Add it to input queue
	MOVEM 1,LSTMSG		;As new last message
	SETZM (1)		;Zero it's next pointer
	ADDI 1,1		;Point to first data field

	MOVEI 2,INPUP		;Code to copy INPUP into a free message block
	LDB 0,OKF		;Converting from data format used by 11
	MOVEM 0,OK(1)
	LDB 0,CMDF
	MOVEM 0,CMD(1)
	LDB 0,DEVF
	MOVEM 0,DEV(1)
	LDB 0,BITSF
	MOVEM 0,BITS(1)
	LDB 0,NF
	TRNE 0,100000		;Is N < 0?
	IORI 0,[777777700000]	; Yes - sign extend it
	MOVEM 0,N(1)
	LDB 0,ERRORF
	MOVEM 0,ERROR(1)	;May not be meaningful
	LDB 0,EVTF
	MOVEM 0,EVT(1)
	ADDI 1,DUR
	HRLZI 3,-=16
PINT3:	SKIPN 4,INPUP+10(3)	;Get next floating point number
	JRST PINT4		;If it's zero, no conversion needed
	MOVE 5,[000777777760]	;Mask to get fraction
	AND 5,4			;Get fraction bits
	LSH 5,-1		;Restore highest order bit
	TLO 5,000400
	AND 4,EXPMSK		;Get sign & exponent bits
	IOR 4,5			;Retrieve fixed-up fractional part
	TLZE 4,400000		;See if sign bit is set
	MOVNS 4			; & if so, negate exponent & fraction too
PINT4:	MOVEM 4,(1)		;Store it in new message block
	AOJ 1,			;Bump pointer
	AOBJN 3,PINT3		;Do all of the floating point fields
	AOS @MSGFLG		;Set message pending flag for AL

PINTX:	MTAPE ARMCHN,PUPGOT	;Anything else pending for us?
	SKIPA			; No
	JRST PUPINT		; Yes - go deal with it
	DISMIS			;All done

;Routines to connect/disconnect Al & arm servo via ethernet: CONNEC & DISCON

UBEHEBE ← 304			;11/45 ethernet address
PISGAH  ← 323			;11/60 ethernet address

CONNEC:	OPEN ARMCHN,OPNPUP	;Connect us to device PUP so can use ethernet
	CAI 0,0			;No-op = error return
	MOVEI 1,UBEHEBE		;Try 11/45 first
C0:	MOVEM 1,ARMHST
	MTAPE ARMCHN,CONARM	;Get ready to send to an ARM servo server

	HRRZI 4,5		;We'll try 5 times
C1:	HRRZI 1,HELLOP		;Say HELLO to ARM Servo server
	DPB 1,ACKTYP
	HRRZI 1,=22		;Size of HELLO pup = pup overhead
	DPB 1,ACKLEN
	OUTPUT ARMCHN,PUPACK	;Send packet away

	MOVEI 1,2		;Sleep for two seconds to give ARM a chance
	SLEEP 1,		; to answer

C2:	MTAPE ARMCHN,PUPGOT	;Anything sent to us?
	SKIPA			; No
	JRST C10		; Yes - handle below
	SOJG 4,C1		;Try several times
C3:	CLOSE ARMCHN,0		;All done with this connection
	MOVEI 1,PISGAH
	CAME 1,ARMHST		;Have we tried the 11/60 too?
	JRST C0			; No - go see if it has a running arm servo
	SETZ 3,			; Yes - tried both 11's, return failure
	JRST C100

C10:	INPUT ARMCHN,PUPIN	;Read in the reply
	LDB 1,INPTYP		;Get PUP type
	CAIN 1,ARMBSY		;Is the ARM Servo busy?
	JRST C3			; Yes - try other machine
	CAIE 1,ARMFRE		;Is it an ARM FREE pup?
	JRST C2			; No - try again
	SETO 3,			; Yes - return success
	MOVE 1,ARMHST
	MOVEM 1,(2)		;Return arm servo server host number
	HRLZI 1,10		;INTINP bit
	INTORM 1,		;Enable interrupts for receiving PUP packets
	HRRZI 1,INTVEC		;Use INTVEC instead of JOBCNI, JOBTPC & JOBAPR
	MOVEM 1,JOBINT		;So Pascal can use old style interrupts
	SETZM OUTSEQ		;Zero sequence ids
	SETZM INSEQ

C100:	MOVEM 3,1(P)		;Return success or failure
	POPJ P,


DISCON:	HRRZI 1,BYEBYE		;Say "So long" to arm servo
	DPB 1,ACKTYP
	HRRZI 1,=22		;Size of goodbye pup = pup overhead
	DPB 1,ACKLEN
	OUTPUT ARMCHN,PUPACK	;Send packet away
	POPJ P,

	RELOC			;Back to low seg

OPNPUP:	15			;Data for OPEN UUO to connect us to device PUP
	SIXBIT /PUP/
	XWD 0,0

CONARM:	0			;Connect
	0			;Status
	-1			;Let WAITS generate local socket number
	0			;Don't wait
	10			;Byte size
	106			;Foreign socket = arm servo server
ARMHST:	304			;Foreign host = Ubehebe (304) or Pisgah (323)

PUPGOT:	10			;Skip if any input present

	RELOC			;To high seg

;Ethernet routine to talk through speech synthesizer on 11/45

TLKCHN ← 15			;Channel used for AL to talk over
TLKPUP ← 300			;PUP type for talk packets (never used?)

TALK11:	MOVE 6,PUPDAT		;Start of data in OUTPUP packet
	MOVE 4,2		;Length of text is in AC2
	SKIPE TALKON		;Have we established talk connection yet?
	JRST TALK0		; Yes
	OPEN TLKCHN,OPNPUP	; No - connect us to device PUP
	CAI 0,0			;No-op = error return
	MTAPE TLKCHN,CONTLK	;Open connection to talk over
	SETO TALKON		;Indicate connection is now established
	MOVEI 1," "
	IDPB 1,6
	MOVEI 1,5		;Set up standard AL voice (a la jjc) = "↑E 20P"
	IDPB 1,6		; & move it into buffer
	MOVEI 1,"2"
	IDPB 1,6
	MOVEI 1,"0"
	IDPB 1,6
	MOVEI 1,"P"
	IDPB 1,6
	MOVEI 1," "
	IDPB 1,6
	ADDI 2,6		;Text length + set up string

TALK0:	MOVE 5,[POINT 7,(3)]	;Move text pointed to by AC3
TALKLP:	ILDB 1,5		;Get next char
	IDPB 1,6		;Move it into buffer
	SOJG 4,TALKLP		;Get them all

	ADDI 2,=22		;Add in pup overhead = pup length
	DPB 2,PUPLEN
	HRRZI 1,TLKPUP		;Set PUP type even if never used
	DPB 1,PUPTYP
	ADDI 2,3		;Convert from bytes to words for OUTPUT UUO
	LSH 2,-2		; = (# chars + pup overhead + 3)/4
	MOVN 2,2
	HRLM 2,PUPOUT		;Set size for dump mode command list
	OUTPUT TLKCHN,PUPOUT	;Send packet away

	MOVEI 1,1		;Sleep for one second so we don't overload
	SLEEP 1,		;the receiving server
	POPJ P,

	RELOC			;Back to low seg

TALKON:	0			;Set to non-zero after connection setup
CONTLK:	0			;Connect
	0			;Status
	-1			;Let WAITS generate local socket number
	0			;Don't wait
	10			;Byte size
	105			;Foreign socket = speech synthesizer server
	323			;Foreign host = Pisgah (11/60)

	RELOC			;To high seg

END